#|________________________________________________________________
 |
 | graphic1.lsp 
 | contains code for expanded menu-item-template 
 | color and symbol pallet overlay objects
 | and for some of the menu item methods
 | copyright (c) 1999-2003 by Forrest W. Young
 |________________________________________________________________
 |#
 

      
#|___________________________________
 |
 | MENU TEMPLATE ITEM METHODS
 |___________________________________
 |#


(defmeth graph-proto :set-line-width ()
  (send self :ray-line-width (first
        (get-value-dialog "Set Ray Line Width" 
                          :initial (send self :ray-line-width))))
  (send self :linestart-width (iseq (send self :num-lines)) 
        (send self :ray-line-width))
  (send self :redraw)
  )

(defmeth graph-proto :view-selection ()
"Produces a spreadplot for the selected observations in the plot"
  (if (not (send self :statistical-object))
      (error-message "Unknown statistical object")
      (let* ((stat-object (send  self :statistical-object))
             (prev-obs-states (send stat-object :obs-states))
             (obs-states (repeat 'NORMAL (length prev-obs-states)))
             )
        (setf (select obs-states (send self :selection)) 'SELECTED)
        (send stat-object :obs-states obs-states)
        (send stat-object :visualize-data)
        t)))

(defmeth graph-proto :on-top-menu-item (&optional (on-top nil on-top?))
"Arg: &optional on-top
Creates an ALWAYS-ON-TOP menu item. If ON-TOP is T the window is also put in ON-TOP state."
  (let* ((ontop-menu-item 
          (send menu-item-proto 
                :new "Always On Top"
                :action #'(lambda () (do-top-action)))))
    (defun do-top-action ()
      (let* ((graf (send ontop-menu-item :slot-value 'graph)))
         (send graf :always-on-top (not (send graf :always-on-top)))
         (send ontop-menu-item :mark (send graf :always-on-top))))
    (send ontop-menu-item :add-slot 'graph self)
    (when (and on-top on-top?) (send ontop-menu-item :do-action))
    ontop-menu-item 
    ))

(defmeth graph-proto :maximize-menu-item (&optional (max nil max?))
"Arg: &optional max
Creates a MAXIMIZE/RESTORE menu item. If MAX is T the window is also put in MAXIMIZED state."
  (let* ((graf self)
         (max-menu-item
          (send menu-item-proto 
                :new "Maximize"
                :action #'(lambda () (do-max-action)))))
    (defun do-max-action ()
        (send graf :zoom-zip (not (send graf :zoom-zip)))
        (send max-menu-item :title (if (send graf :zoom-state) "Restore" "Maximize")))
    (send max-menu-item :add-slot 'graph self)
    (when (and max max?) (send max-menu-item :do-action))
    max-menu-item
    ))

(defmeth graph-proto :pop-out-menu-item (&optional (pop-out nil pop-out?))
"Arg: &optional pop-out
Creates a POP-OUT menu item. If POP-OUT is T the window is also put in POP-OUT state."
  (let* ((pop-out-menu-item 
          (send menu-item-proto 
                :new "Pop Out"
                :action #'(lambda () (pop-out-action)))))
    (defun pop-out-action ()
      (let* ((graf (send pop-out-menu-item :slot-value 'graph)))
         (send graf :pop-put (not (send graf :pop-put)))
         (send pop-out-menu-item :title 
               (if (send graf :pop-put) "Put In" "Pop Out"))))
    (send pop-out-menu-item :add-slot 'graph self)
    (when (and pop-out pop-out?) (send pop-out-menu-item :do-action))
    pop-out-menu-item 
    ))



(defmeth graph-proto :show-plots-menu-item ()
"Arg: none
Creates the SHOW PLOTS a menu item. When graph is Linked the item title is SHOW LINKED PLOTS name, otherwise SHOW CURRENT PLOTS. The item causes all of the (linked) plots associated with the current data object to be shown."
  (let* ((graf self)
         (item (send menu-item-proto 
                     :new "Show Plots"
                     :action #'(lambda () (show-plots) ))))
    (setf *show-linked-plots* item)
    (defun show-plots ()
      (send (send graf :data-object) :show-plots (send graf :linked)))
    (defmeth item :update ()
      (send self :title  (if (send graf :linked) 
                             "Show Linked Plots" 
                             (strcat "Show " 
                                     (string-capitalize (send (send graf :data-object) :name))
                                     " Plots"))))
    item))


(defmeth graph-proto :hide-plots-menu-item ()
"Arg: none
Creates the HIDE PLOTS a menu item. When graph is Linked the item title is HIDE LINKED PLOTS, otherwise HIDE CURRENT PLOTS. The item causes all of the (linked) plots associated with the current data object to be hidden."
  (let* ((graf self)
         (item (send menu-item-proto 
                     :new "Hide Plots"
                     :action #'(lambda () (hide-plots) ))))
    (setf *hide-linked-plots* item)
    (defun hide-plots ()
      (send (send graf :data-object) :hide-plots (send graf :linked)))
    (defmeth item :update ()
      (send self :title  (if (send graf :linked)
                             "Hide Linked Plots" 
                             (strcat "Hide " 
                                     (string-capitalize (send (send graf :data-object) :name))
                                     " Plots"))))
    item))

(defmeth graph-proto :close-plots-menu-item ()
"Arg: none
Creates the CLOSE PLOTS menu item. When graph is linked the item title is CLOSELINKED PLOTS, otherwise CLOSE CURRENT PLOTS. The item causes all of the (linked) plots associated with the current data object to be closed."
  (let* ((graf self)
         (item (send menu-item-proto 
                     :new "Close Plots"
                     :action #'(lambda () (close-plots) ))))
    (setf *close-linked-plots* item)
    (defun close-plots ()
      (send (send graf :data-object) :close-plots (send graf :linked)))
    (defmeth item :update ()
      (send self :title  (if (send graf :linked)
                             "Close Linked Plots" 
                             (strcat "Close " 
                                     (string-capitalize (send (send graf :data-object) :name))
                                     " Plots"))))
    item))

(defun print-plot ()
  (pdf-print))

(defun pdf-print () 
  (when (two-button-dialog (format nil "Print as PDF not yet available.~%Print Bitmap Image Instead?"))
        (mws-print)))

(defun save-plot ()
  (pdf-save))

(defun pdf-save () 
  (when (two-button-dialog (format nil "Save Image as a PDF File not yet available.~%Copy Bitmap Image to ClipBoard Instead?"))
        (mws-copy)))

(defmeth graph-proto :ask-print-pdf ()
  (when (two-button-dialog (format nil "Print as PDF not yet available.~%Print Bitmap Image Instead?"))
        (send self :do-msw-print)))

(defmeth graph-proto :ask-save-pdf ()
  (when (two-button-dialog (format nil "Save Image as a PDF  File not yet available.~%Copy Bitmap Image to Clipboard instead?"))
        (send self :do-msw-copy)))

(defmeth graph-proto :do-msw-print ()
  (msw-print))

(defmeth graph-proto :do-msw-copy ()
  (msw-copy))

      
#|___________________________________
 |
 | MENU TEMPLATE METHODS
 |___________________________________
 |#

(defmeth graph-proto :popup-menu-template ()
  '(showing-labels mouse resize-brush dash 
    erase-selection focus-on-selection view-selection dash
    select-all show-all dash
    selection slicer dash
    symbol color))

(send graph-proto :menu-template 
      '(help dash new-x new-y dash link dash
        on-top maximize dash print save copy))
         
#|
 | MAKE-MENU-ITEM
 |#

(defun menu-symbols ()
      '(dash help new-x new-y new-x link 
             showing-labels mouse resize-brush 
             erase-selection focus-on-selection view-selection 
             select-all show-all 
             selection slicer 
             symbol color 
             show-plot hide-plots close-plots 
             on-top maximize pop-out print save copy 
             save-data create-data redraw rescale options line-width no-items))

(defmeth graph-proto :make-menu-item (item-template)
  (if (kind-of-p item-template menu-item-proto)
      item-template
      (case item-template
        (dash (send dash-item-proto :new))
        (help 
         (send graph-item-proto :new "Help" self :plot-help))
        (new-x
         (send graph-item-proto :new "New X Axis ..." self :new-x))
        (new-y
         (send graph-item-proto :new "New Y Axis ..." self :new-y))
        (new-z
         (send graph-item-proto :new "New Z Axis ..." self :new-z))
        (link (send link-item-proto :new self))
        (showing-labels 
         (send graph-item-proto :new "Show Labels" self
               :showing-labels :showing-labels :toggle t))
        (mouse (send mouse-mode-item-proto :new self))
        (resize-brush 
         (send graph-item-proto :new "Resize Brush" self :resize-brush))
        (erase-selection
         (send graph-item-proto :new "Remove Selection" self 
               :erase-selection :any-points-selected-p))
        (focus-on-selection
         (send graph-item-proto :new "Focus on Selection" self 
               :focus-on-selection :any-points-selected-p))
	(view-selection 
         (send graph-item-proto :new "View Selection" self 
               :view-selection :any-points-selected-p))
        (select-all
         (send graph-item-proto :new "Select All" self
               :select-all-points :all-points-showing-p))
        (show-all
         (send graph-item-proto :new "Show All" self 
               :show-all-points :all-points-showing-p :negate t))
        (symbol
         (let ((symbol-pallet-menu-item (send menu-item-proto :new "Symbol Pallet")))
           (defmeth symbol-pallet-menu-item :do-action ()
             (let* ((menu (send self :menu))
                    (graph (if menu (send menu :graph)))
                    )
               (when graph (send graph :toggle-pallet "symbol")
                     (send self :mark (not (send self :mark))))))
           symbol-pallet-menu-item))
        (color
         (let* ((color-pallet-menu-item (send menu-item-proto :new "Color Pallet")))
           (defmeth color-pallet-menu-item :do-action ()
             (let* ((menu (send self :menu))
                    (graph (if menu (send menu :graph)))
                    )
               (when graph (send graph :toggle-pallet "color")
                     (send self :mark (not (send self :mark))))))
           color-pallet-menu-item))
      
        (selection
         (send graph-item-proto :new "Selection ..." self 
               :selection-dialog))
        (slicer
	 (if (not (small-machine-p))
	     (send graph-item-proto :new
		   "Slicer ..." self :make-slicer-dialog)))
       	(show-plots  (send self :show-plots-menu-item))
       	(hide-plots  (send self :hide-plots-menu-item))
       	(close-plots (send self :close-plots-menu-item))
        (on-top      (send self :on-top-menu-item))
        (maximize    (send self :maximize-menu-item))
        (pop-out     (send self :pop-out-menu-item))
        (print
         (send graph-item-proto :new "Print Plot" self :ask-print-pdf))
       	(save
       	 (send graph-item-proto :new "Save Plot As ..." self :ask-save-pdf))
        (copy 
          (send graph-item-proto :new "Copy Plot" self :do-msw-copy))
	(save-data
	  (send graph-item-proto :new "Save Data As ..." self :save-data-as))
	(create-data
	  (send graph-item-proto :new "Create Data Object" self :create-data-object))
        (redraw 
         (send graph-item-proto :new "Redraw Plot" self :redraw))
        (rescale 
         (send graph-item-proto :new "Rescale Plot" self :adjust-to-data))
        (options 
	 (if (not (small-machine-p))
	     (send graph-item-proto :new "Options ..." self :set-options)))
        (line-width
         (send graph-item-proto :new "Ray Line Width ..." self :set-line-width))
        (no-items
	 (send menu-item-proto :new "No Items" :enabled nil))
        )))


(defmeth menu-proto :graph (&optional (objid nil set))
"Args: (&optional objid) objid of graph object for which this is a menu"
  (unless (send self :has-slot 'graph)
          (send self :add-slot 'graph))
  (if set (setf (slot-value 'graph) objid))
  (slot-value 'graph))

(defmeth graph-proto :new-menu (&optional title 
                                     &key (items (send self :menu-template))
                                          (popup-items (send self :popup-menu-template)))
  (if (slot-value 'menu) 
      (send (slot-value 'menu) :dispose))
  (unless title (setq title (slot-value 'menu-title)))
  (flet ((make-item (item) (send self :make-menu-item item)))
    (let ((menu (send menu-proto :new title)))
      (send self :menu menu)
      (when popup-items 
        (send self :make-two-plot-menus title :hotspot-items items :popup-items popup-items))
      (apply #'send menu :append-items  
             (remove nil (mapcar #'make-item items)))
      (send menu :graph self)
      (send menu-proto :new title))))

#|replaced by PV modified version below
(defmeth graph-proto :make-two-plot-menus 
  (title &key hotspot-items popup-items)
"Args: TITLE &KEY HOTSPOT-ITEMS POPUP-ITEMS
Makes pull-down and popup menus for plots and plotcells. TITLE is title of the menu if it appears in the menubar. HOTSPOT-ITEMS is the menu items for the pulldown that appears with a left-click on the menubar menu or the pull-down hotspot. POPUP-ITEMS is a set of  menu items that popup from the plot when the plot is right clicked."
  (send self :make-hotspot-menu-items hotspot-items) ;store items in a slot
  (send self :make-popup-menu-items popup-items)  ;create secondary items, store in slot
  (send (send self :menu) :remove)  ;remove menu from menubar so it can be popped up
  (defmeth self :do-click (x y m1 m2)
    (let* ((menu (send self :menu))
           (hotspot-menu-items (send self :hotspot-menu-items)) 
           (popup-menu-items (send self :popup-menu-items)))
      (cond
       (m2 
        (when (and popup-menu-items (> y 18))
              (send menu :remove)
              (apply #'send menu :delete-items (send menu :items))
              (apply #'send menu :append-items popup-menu-items)
              (send menu :popup-menu x y self)
              (send self :menu menu)))
        (t 
         (send menu :remove)
         (apply #'send menu :delete-items (send menu :items))
         (apply #'send menu :append-items hotspot-menu-items)
         (call-next-method x y m1 m2)
         (send self :menu menu)))
      t))
  (send (send self :menu) :graph self)
  (send (send self :menu) :remove)
  (send self :menu))
|#

  (defmeth graph-proto :make-two-plot-menus
     (title &key hotspot-items popup-items)
  "Args: TITLE &KEY HOTSPOT-ITEMS POPUP-ITEMS
  Makes pull-down and popup menus for plots and plotcells. TITLE is title of
  the menu if it appears in the menubar. HOTSPOT-ITEMS is the menu items for
  the pulldown that appears with a left-click on the menubar menu or the
  pull-down hotspot. POPUP-ITEMS is a set of  menu items that popup from the
  plot when the plot is right clicked."
     (send self :make-hotspot-menu-items hotspot-items) ;store items in a slot
     (send self :make-popup-menu-items popup-items)  ;create secondary items, store in slot
          (when (send self :menu)
     (send (send self :menu) :remove) ) ;remove menu from menubar so it can be popped up
     (defmeth self :do-click (x y m1 m2)

       (let* ((menu (send self :menu))
              (hotspot-menu-items (send self :hotspot-menu-items))
              (popup-menu-items (send self :popup-menu-items)))
         (cond
          ((and m2 (send self :menu))
           (when (and popup-menu-items (> y 18))
                 (apply #'send menu :delete-items (send menu :items))
                 (apply #'send menu :append-items popup-menu-items)
                 (send menu :popup-menu x y self)
                 (send self :menu menu)))
           (t
            (when (send self :menu)
                  (send menu :remove)
                  (apply #'send menu :delete-items (send menu :items))
                  (apply #'send menu :append-items hotspot-menu-items))
            (call-next-method x y m1 m2)
            (send self :menu menu)))
         t)
     (when (send self :menu)
           (send (send self :menu) :graph self)
           (send (send self :menu) :remove))
     (send self :menu)))



(defmeth graph-proto :make-popup-menu-items (items)
  (send self :popup-menu-items
        (mapcar #'(lambda (item) 
                    (send self :make-menu-item item))
                items)))

(defmeth graph-proto :make-hotspot-menu-items (items)
  (send self :hotspot-menu-items
        (mapcar #'(lambda (item) 
                    (send self :make-menu-item item))
                items)))

(defmeth graph-proto :popup-menu-items (&optional (obj-list nil set))
  (unless (send self :has-slot 'popup-menu-items)
          (send self :add-slot 'popup-menu-items))
  (if set (setf (slot-value 'popup-menu-items) obj-list))
  (slot-value 'popup-menu-items))

(defmeth graph-proto :hotspot-menu-items (&optional (obj-list nil set))
  (unless (send self :has-slot 'hotspot-menu-items)
          (send self :add-slot 'hotspot-menu-items))
  (if set (setf (slot-value 'hotspot-menu-items) obj-list))
  (slot-value 'hotspot-menu-items))


(defmeth graph-proto :append-always-on-top-menu-item (&optional (on-top nil on-top?))
"Arg: &optional on-top
Appends an ALWAYS-ON-TOP menu item to the window's menu. If ON-TOP is T the window is also put in ON-TOP state."
  (send (send self :menu) :append-items (send self :on-top-menu-item)))

(defmeth graph-proto :append-maximize-restore-menu-item (&optional (max nil max?))
"Arg: &optional max
Appends a MAXIMIZE/RESTORE menu item to the window's menu. If MAX is T the window is also put in MAXIMIZED state."
  (send (send self :menu) :append-items (send self :maximize-menu-item)))


#|________________________________________________
 | 
 | COLOR AND SYMBOL PALLETS
 |________________________________________________
 |#


    
(setf *color-pallet* nil)
(setf *symbol-pallet* nil)


(defun color-pallet ()
  (send self :toggle-pallet "color"))

(defun symbol-pallet ()
  (send self :toggle-pallet "symbol"))

(defmeth graph-proto :set-selection-color () 
  (send self :toggle-pallet "color"))

(defmeth graph-proto :set-selection-symbol () 
  (send self :toggle-pallet "symbol"))

(defmeth graph-proto :selection-overlay (&optional (objid nil set))
"Args: (&optional objid) selection-overlay slot."
  (unless (send self :has-slot 'selection-overlay)
          (send self :add-slot 'selection-overlay))
  (if set (setf (slot-value 'selection-overlay) objid))
  (slot-value 'selection-overlay))

(defmeth graph-proto :color-pallet (&optional (logical nil set))
"Args: (&optional logical) indicates whether color pallet is showing."
  (unless (send self :has-slot 'color-pallet)
          (send self :add-slot 'color-pallet))
  (if set (setf (slot-value 'color-pallet) logical))
  (slot-value 'color-pallet))

(defmeth graph-proto :symbol-pallet (&optional (logical nil set))
"Args: (&optional logical) indicates whether symbol pallet is showing."
  (unless (send self :has-slot 'symbol-pallet)
          (send self :add-slot 'symbol-pallet))
  (if set (setf (slot-value 'symbol-pallet) logical))
  (slot-value 'symbol-pallet))

(defmeth graph-proto :toggle-color-pallet () 
  (send self :toggle-pallet "color"))

(defmeth graph-proto :toggle-symbol-pallet ()
  (send self :toggle-pallet "symbol"))

(defmeth graph-proto :toggle-pallet (type)
  (let* ((selection-overlay (send self :selection-overlay))
         (color-pallet (send self :color-pallet))
         (symbol-pallet (send self :symbol-pallet)))

    (when (not selection-overlay) 
          (send self :selection-overlay (send selection-overlay-proto :new))
          (apply #'send self :margin (+ (send self :margin) '(0 20 0 0)))
          (send self :add-overlay (send self :selection-overlay))
          )

    (cond 
      ((equal type "color")  (send self :color-pallet  (not (send self :color-pallet))))
      ((equal type "symbol") (send self :symbol-pallet (not (send self :symbol-pallet)))))
    
    (when (and (not (send self :symbol-pallet))
               (not (send self :color-pallet)))
          (apply #'send self :margin (- (send self :margin) '(0 20 0 0)))
          (send self :delete-overlay selection-overlay)
          (send self :selection-overlay nil)
          )
    
    (send self :redraw)
    ))

     
(defmeth graph-proto :toggle-symbol-pallet ()
  (let* ((pallet-overlay (send self :selection-overlay))
         (color-pallet (send self :color-pallet))
         (symbol-pallet (send self :symbol-pallet)))
    (cond
      ((not pallet-overlay) 
       (send self :add-pallet-overlay)
       (send self :show-symbol-pallet)
       )
      ((not symbol-pallet)
       (send self :show-symbol-pallet))
      (color-pallet
       (send self :hide-symbol-pallet))
      (t
       (send self :hide-symbol-pallet)
       (send self :delete-pallet-overlay)))
    ))    


(defmeth graph-proto :toggle-selection-pallets ()
"Args: none
Toggels pallet overlay and pallets to toolbar."
  (let* ((selection-overlay (send self :selection-overlay)))
    (cond 
      (selection-overlay
       (apply #'send self :margin (- (send self :margin) '(0 20 0 0)))
       (send self :delete-overlay selection-overlay)
       (send self :selection-overlay nil)
       (send self :redraw)
       )
      (t
       (send self :selection-overlay (send selection-overlay-proto :new))
       (apply #'send self :margin (+ (send self :margin) '(0 20 0 0)))
       (send self :add-overlay (send self :selection-overlay))
       (send self :redraw)
       ))
    ))

(setf color-16-list (list 'WHITE 'PINK 'LIGHT-BLUE 'YELLOW  'ORANGE  'CYAN 
'GREEN   'MAGENTA  'RED 'DARK-RED 'DARK-GREEN 'VIOLET 'BLUE 
'GREY  'BROWN   'BLACK))

(defproto selection-overlay-proto '(color-mode color-x color-y symbol-x symbol-y) nil vista-graph-overlay-proto)

(defmeth selection-overlay-proto :isnew ()
  (send self :color-mode *color-mode*)
  (call-next-method)
  )

(defmeth selection-overlay-proto :color-mode 
  (&optional (logical nil set))
  (if set (setf (slot-value 'color-mode) logical))
  (slot-value 'color-mode))

(defmeth selection-overlay-proto :color-x 
  (&optional (coordinate nil set))
  (if set (setf (slot-value 'color-x) coordinate))
  (slot-value 'color-x))

(defmeth selection-overlay-proto :color-y 
  (&optional (coordinate nil set))
  (if set (setf (slot-value 'color-y) coordinate))
  (slot-value 'color-y))

(defmeth selection-overlay-proto :symbol-x 
  (&optional (coordinate nil set))
  (if set (setf (slot-value 'symbol-x) coordinate))
  (slot-value 'symbol-x))

(defmeth selection-overlay-proto :symbol-y 
  (&optional (coordinate nil set))
  (if set (setf (slot-value 'symbol-y) coordinate))
  (slot-value 'symbol-y))

(defmeth selection-overlay-proto :which-button 
  (x y button-x button-y button-width button-height)
  (let* ((indices-x (which (< button-x x (+ button-x button-width))))
         (indices-y (which (< button-y y (+ button-y button-height))))
         (index (intersection indices-x indices-y)))
    (first index)))


(defmeth selection-overlay-proto :which-color (x y)
  (let* ((color-x (send self :color-x))
         (color-y (send self :color-y))
         (button-n (if (or color-x color-y)
                       (send self :which-button x y color-x color-y 8 10)
                       nil))
         (color-16 (if button-n (select color-16-list button-n) nil))
         )
    color-16))

(defmeth selection-overlay-proto :which-symbol (x y)
  (let* ((symbol-x (send self :symbol-x))
         (symbol-y (send self :symbol-y))
         (button-n (if (or symbol-x symbol-y)
                       (send self :which-button x y symbol-x symbol-y 8 10)
                       nil))
         (symbol (if button-n (select *plot-symbols* button-n) nil))
         )
    symbol))

(defmeth selection-overlay-proto :redraw ()
   (let* ((graph (send self :graph))
          (color-pallet (send graph :color-pallet))
          (symbol-pallet (send graph :symbol-pallet))
          (width (send graph :canvas-width))
          (height (send graph :canvas-height))
          (margin (send graph :margin))
          (color (send graph :draw-color))
          (backcolor (send graph :back-color))
          (bar-x 5)                  ;x-location of first bar
          (bar-y 18)                 ;y-location of both bars
          (bar-thickness 15)         ;thickness of both bars (should be odd)
          (bar-gap 5)                ;gap between end of first and beginning of second bar
          (color-patch-width 8)      ;width of each color patch
          (color-bar-thickness  bar-thickness) 
          (symbol-bar-thickness bar-thickness)
          (symbol-button-size (- symbol-bar-thickness 4))
          (color-patch-height (- color-bar-thickness 4))
          (color-bar-length   (+ 5 (* 16 color-patch-width)))
          (symbol-bar-length  (+ 4 (* 12 (+ symbol-button-size 1))))
          (color-bar-x bar-x)
          (color-bar-y bar-y)
          (symbol-bar-x (+ bar-x (if color-pallet color-bar-length 0) bar-gap))
          (symbol-bar-y bar-y)
          (vertical (< width (+ 10 (if color-pallet color-bar-length 0) symbol-bar-length)))
          (x) (y) (cx) (cy) (knt 0) (color-x) (color-y) (symbol-x) (symbol-y)
          )
     (when color-pallet
           (send graph :draw-color 'white)
           (send graph :paint-rect 
                 (- color-bar-x 1)
                 (- color-bar-y 0)
                 (+ color-bar-length 2)
                 (+ color-bar-thickness 1))
           (send graph :draw-color 'black) 'black
           (send graph :frame-rect 
                 (- color-bar-x 1)
                 (- color-bar-y 0)
                 (+ color-bar-length 2)
                 (+ color-bar-thickness 1))
           (send graph :draw-color 'grey) 
           (send graph :frame-rect 
                 (- color-bar-x 1)
                 (- color-bar-y 0)
                 (+ color-bar-length 1)
                 (+ color-bar-thickness 0))
           (dotimes (i 16) 
                    (setf x (+ color-bar-x 2 (* i 8)))
                    (setf y (+ color-bar-y 2))
                    (setf color-x (append color-x (list x)))
                    (setf color-y (append color-y (list y)))
                    (send graph :draw-color (nth i color-16-list))
                    (send graph :paint-rect (1+ x) (1+ y) 7 9)
                    (send graph :draw-color 'black) 
                    (send graph :frame-rect x y 9 11)
                    )
           (send self :color-x color-x)
           (send self :color-y color-y)
           )
     (when symbol-pallet
           (cond
             (vertical
              (when (/= (select (send graph :margin) 2) 21)
                    (setf (select margin 2) 21)
                    (apply #'send graph :margin margin) )
              (setf symbol-bar-x (- width symbol-bar-thickness 1))
              (setf symbol-bar-y (+ symbol-bar-y symbol-bar-thickness 8))
              (send graph :draw-color 'toolbar-background)
              (send graph :paint-rect 
                    (- width -1 (third margin)) (- (second margin) 2)
                    (- (third margin) 1) (- height -3 (fourth margin)))
              (send graph :draw-color 'black)
              (send graph :draw-line
                    (- width -1 (third margin)) (- (second margin) 3)
                    (- width -1 (third margin)) height)
              )
             (t
              (when (/= (select (send graph :margin) 2) 0)
                    (setf (select margin 2) 0)
                    (apply #'send graph :margin margin))
              (setf symbol-bar-x (+ bar-x (if color-pallet (+ bar-gap color-bar-length) 0)))
              ))
           (send graph :draw-color 'white)
           (send graph :paint-rect 
                 (- symbol-bar-x 1)
                 (- symbol-bar-y 0)
                 (+ (if vertical symbol-bar-thickness symbol-bar-length) 2)
                 (+ (if vertical symbol-bar-length symbol-bar-thickness) 1))
           (send graph :draw-color 'black) 
           (send graph :frame-rect
                 (- symbol-bar-x  1)
                 symbol-bar-y
                 (+ (if vertical symbol-bar-thickness symbol-bar-length) 2)
                 (+ (if vertical symbol-bar-length symbol-bar-thickness) 1)) 
           (send graph :draw-color 'grey) 
           (send graph :frame-rect 
                 (- symbol-bar-x 1)
                 symbol-bar-y
                 (+ (if vertical symbol-bar-thickness symbol-bar-length) 1)
                 (+ (if vertical symbol-bar-length symbol-bar-thickness) 0))
           (dotimes (i 12)
                    (setf cx (if (< i 5) 8 9))
                    (setf cy (if (< i 5) 7 8))
                    (setf x (+ symbol-bar-x (if vertical 0 (* i 12)) 2))
                    (setf y (+ symbol-bar-y (if vertical (* i 12) 0) 2))
                    (setf symbol-x (append symbol-x (list x)))
                    (setf symbol-y (append symbol-y (list y)))
                    (send graph :frame-rect x y symbol-button-size symbol-button-size)
                    (send graph :draw-color 'white)
                    (send graph :paint-rect (1+ x) (1+ y) 
                          (- symbol-button-size 2) (- symbol-button-size 2))
                    (send graph :draw-color 'black)
                    (send graph :draw-symbol 
                          (nth i *PLOT-SYMBOLS*)
                          nil
                          (if vertical (+ symbol-bar-x -1 cx) (+ symbol-bar-x (* i 12) cy))
                          (if vertical (+ symbol-bar-y (* i 12) cy) (+ symbol-bar-y -1 cx))
                          )
                    )
            
           (send self :symbol-x symbol-x)
           (send self :symbol-y symbol-y)
           )
     (send graph :draw-color color)
     ))
  

(defmeth selection-overlay-proto :do-click (x y m1 m2)
  (when (< 15 y 32)
        (send (send self :graph) :line-type 'solid)
        (let* ((graph (send self :graph))
               (hilight (send graph :points-selected))
               (link-list (remove 'nil (send graph :links)))
               (color  (send self :which-color x y))
               (symbol (send self :which-symbol x y)))
          (when (and hilight (or color symbol))
                (when color (send graph :point-color hilight color))
                (when symbol (send graph :point-symbol hilight symbol))
                (when link-list
                      (dolist (plot link-list)
                              ;(send plot :use-color t)
                              (when color (send plot :point-color hilight color))
                              (when symbol (send plot :point-symbol hilight symbol))
                              (send plot :redraw-content)
                              (send plot :points-selected hilight)))
                (send graph :redraw-content)
                (send graph :points-selected hilight))
          )))

                                                                                                                                  